home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / epistat.arc / FILETRAN.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-08-18  |  5.1 KB  |  96 lines
  1. 1  REM                 FILE TRANSFER PROGRAM
  2. 2  REM             Written by Tracy L. Gustafson, M.D.
  3. 3  REM            Round Rock, Texas. Version 2.0, 1983
  4. 5  DEF SEG=&H40
  5. 8  A=PEEK(&H17): IF NOT(A AND &H20) THEN POKE &H17,(A AND (NOT &H20)) OR &H20
  6. 10  DEF SEG: KEY OFF: SCREEN 0,0: WIDTH 80: COLOR 7,0,1
  7. 20  CLEAR: OPTION BASE 1: DEFINT A-C,N,T,Z: DEFSTR D: AF=0
  8. 30  CLS: PRINT TAB(11);"KEY";STRING$(51,205);"CLOSE"
  9. 33  PRINT TAB(11);"OPEN TRANSFERING A SAMPLE FROM ONE DATAFILE TO ANOTHER OPEN"
  10. 35  PRINT TAB(11);"SCREEN";STRING$(51,205);"LOAD"
  11. 40  PRINT: AP=CSRLIN: PRINT TAB(10);"What is the name of the DATAFILE you want to modify?": PRINT TAB(16);"(REPLACE, ADD, or APPEND a sample to) "
  12. 45  LOCATE AP,65: INPUT "",FILE1$: ON ERROR GOTO 510
  13. 50  OPEN FILE1$ FOR INPUT AS #1: INPUT #1, A,C: CC=C
  14. 80  PRINT: PRINT: INPUT "What is the name of the DATAFILE you wish to retrieve a sample from?  ",FILE2$: ON ERROR GOTO 530
  15. 90  OPEN FILE2$ FOR INPUT AS #2: INPUT #2, AZ,CZ: PRINT
  16. 100  PRINT TAB(5); "What is the SAMPLE NUMBER in ";FILE2$;:INPUT " that you want to retrieve?  ",NSZ
  17. 110  IF NSZ>AZ THEN BEEP: PRINT TAB(15);"The ";FILE2$;" datafile has only";AZ;"samples.": GOTO 100
  18. 120  IF AF=1 THEN 155
  19. 130  PRINT: PRINT: PRINT "Do you want to:   1.)  REPLACE an existing data sample in ";FILE1$
  20. 135  PRINT TAB(19);"2.)  ADD this data sample to ";FILE1$;" as sample #";A+1
  21. 137  PRINT TAB(19);"3.)  APPEND this sample to an existing sample in ";FILE1$
  22. 140  PRINT: PRINT TAB(30);"Enter choice:   ";
  23. 145  INPUT "",ASUB: IF ABS(ASUB-2)>1.1 THEN BEEP: GOTO 145
  24. 148  ON ASUB GOTO 150,152,155
  25. 150  AT=A: PRINT TAB(17);: INPUT "What sample do you want to replace?  ",NSR: IF NSR>A THEN BEEP: PRINT TAB(15);"The ";FILE1$;" datafile has only";A;"samples.": GOTO 150 ELSE 160
  26. 152  IF A<28 THEN NSR=A+1: AT=A+1: GOTO 160 ELSE BEEP: PRINT "You cannot ADD to this DATAFILE. ": PRINT TAB(3);FILE1$;"  already has the maximum number of samples allowed (28).": GOTO 130
  27. 155  NSR=A+1: AT=A+1: PRINT TAB(17);: INPUT "What sample do you want to append to?  ",NSA: IF NSA>A THEN BEEP: PRINT TAB(15);"The ";FILE1$;" datafile has only";A;"samples.": GOTO 155
  28. 160  PRINT: PRINT: COLOR 23: PRINT TAB(29);"TRANSFERING SAMPLES": COLOR 7
  29. 162  IF AF=1 THEN 220
  30. 165  DIM D(AT,2000/AT),CS(AT,2000/AT),T(AT),N$(AT),X(AT),X2(AT),MD(AT),SD(AT),TZ(28)
  31. 170  FOR T=1 TO A: INPUT #1,T(T): NEXT
  32. 180  FOR T=1 TO A: FOR Z=1 TO C: INPUT #1, D(T,Z): NEXT: NEXT
  33. 190  FOR T=1 TO A: FOR Z=1 TO T(T): INPUT #1, CS(T,Z): NEXT: NEXT
  34. 200  FOR T=1 TO A: INPUT #1, N$(T), X(T), X2(T), MD(T),SD(T): NEXT: CLOSE #1
  35. 220  FOR T=1 TO NSZ-1: INPUT #2,TZ(T): NEXT
  36. 230  INPUT #2,T(NSR): FOR T=NSZ+1 TO AZ: INPUT #2, TZ(T): NEXT
  37. 240  FOR T=1 TO NSZ-1: FOR Z=1 TO CZ: INPUT #2,DZ: NEXT: NEXT
  38. 250  FOR Z=1 TO CZ: INPUT #2, D(NSR,Z): NEXT
  39. 260  FOR T=NSZ+1 TO AZ: FOR Z=1 TO CZ: INPUT #2,DZ: NEXT: NEXT
  40. 270  FOR T=1 TO NSZ-1: FOR Z=1 TO TZ(T): INPUT #2, CSZ: NEXT: NEXT
  41. 280  FOR Z=1 TO T(NSR): INPUT #2, CS(NSR,Z): NEXT
  42. 290  FOR T=NSZ+1 TO AZ: FOR Z=1 TO TZ(T): INPUT #2, CSZ: NEXT: NEXT
  43. 300  FOR T=1 TO NSZ-1: INPUT #2,NZ$,XZ,X2Z,MDZ,SDZ: NEXT
  44. 310  INPUT #2, N$(NSR),X(NSR),X2(NSR),MD(NSR),SD(NSR)
  45. 320  FOR T=NSZ+1 TO AZ: INPUT #2, NZ$,XZ,X2Z,MDZ,SDZ: NEXT: CLOSE #2
  46. 325  IF ASUB<3 THEN 350 ELSE AT=T(NSA)+1
  47. 330  T(NSA)=T(NSA)+T(NSR): X(NSA)=X(NSA)+X(NSR): X2(NSA)=X2(NSA)+X2(NSR)
  48. 333  FOR AZ=1 TO CZ: CC=CC+1: D(NSA,CC)=D(NSR,AZ): IF D(NSA,CC)="" THEN 342 ELSE VC=VAL(D(NSA,CC))
  49. 335  FOR Z=1 TO AT-1: VX=VAL(D(NSA,CS(NSA,Z))): IF VX<=VC THEN 338
  50. 337  FOR TZ=AT TO Z+1 STEP -1: CS(NSA,TZ)=CS(NSA,TZ-1): NEXT: GOTO 340
  51. 338  NEXT Z
  52. 340  CS(NSA,Z)=CC: AT=AT+1
  53. 342  NEXT AZ: IF CC>CMAX THEN CMAX=CC
  54. 345  N=T(NSA): IF N MOD 2=0 THEN MD(NSA)=(VAL(D(NSA,CS(NSA,N/2)))+VAL(D(NSA,CS(NSA,N/2+1))))*0.5 ELSE MD(NSA)=VAL(D(NSA,CS(NSA,N/2+0.5)))
  55. 347  SD(NSA)=SQR((X2(NSA)-X(NSA)*X(NSA)/N)/(N-1))
  56. 350  PLAY "MB O3 T200 L16 GF#GF#GF#GF#GF#GF# L10 G.D O2 L7 BGD O1 L6 B L3 G"
  57. 352  CLS: PRINT: PRINT TAB(5);"A memory file has been constructed that ";: IF ASUB=3 THEN PRINT "APPENDS "; ELSE PRINT "ADDS ";
  58. 355  PRINT "sample";NSZ;"FROM ";FILE2$;: IF ASUB=3 THEN PRINT TAB(20);"TO sample";NSA;"IN "; ELSE PRINT TAB(12);"TO ";
  59. 358  PRINT "datafile ";FILE1$;
  60. 360  IF ASUB=1 THEN PRINT "   (REPLACING sample number";NSR;")": GOTO 365 ELSE IF ASUB=2 THEN PRINT "   (NEW sample number =";NSR;")": GOTO 365
  61. 362  PRINT: PRINT: PRINT "  Do you want to APPEND data to another sample in DATAFILE ";FILE1$;: INPUT " ?  ",A$
  62. 364  IF A$="y" OR A$="Y" THEN CC=C: AF=1: GOTO 80 ELSE IF A$="n" OR A$="N" THEN 365 ELSE BEEP: GOTO 362
  63. 365  PRINT: PRINT TAB(10);"How do you want to SAVE this modified datafile to disk:"
  64. 370  PRINT: PRINT TAB(20);"1.)  Under the filename ";FILE1$;"."
  65. 375  PRINT TAB(20);"2.)  Under a NEW filename."
  66. 380  PRINT TAB(20);"3.)  CANCEL file modification.": PRINT
  67. 385  PRINT TAB(26);"Enter choice:   ";
  68. 390  INPUT "",B: IF ABS(B-2)>1.1 THEN BEEP: GOTO 390 ELSE IF B=3 THEN 470
  69. 400  IF B=2 THEN PRINT TAB(20);: INPUT "Enter NEW FILENAME:   ",FILE3$ ELSE FILE3$=FILE1$
  70. 410  IF ASUB=3 THEN C=CMAX ELSE A=AT: IF CZ>C THEN C=CZ
  71. 415  ON ERROR GOTO 550
  72. 420  OPEN FILE3$ FOR OUTPUT AS #1
  73. 430  WRITE #1, A,C: FOR T=1 TO A: WRITE #1, T(T): NEXT
  74. 440  FOR T=1 TO A: FOR Z=1 TO C: WRITE #1, D(T,Z): NEXT: NEXT
  75. 450  FOR T=1 TO A: FOR Z=1 TO T(T): WRITE #1, CS(T,Z): NEXT: NEXT
  76. 460  FOR T=1 TO A: WRITE #1, N$(T),X(T),X2(T),MD(T),SD(T): NEXT: CLOSE #1
  77. 470  PRINT: PRINT: PRINT TAB(8);
  78. 480  INPUT "Do you want to perform another FILE TRANSFER? (Y or N)  ",A$
  79. 490  IF A$="y" OR A$="Y" THEN 10
  80. 500  END
  81. 510  BEEP: IF ERR<>53 THEN 600
  82. 515  PRINT: PRINT: PRINT TAB(13); "I cannot find a file by that name on drive ";
  83. 520  IF MID$(FILE1$,2,1)=":" THEN DR$=LEFT$(FILE1$,2) ELSE DR$="A:"
  84. 525  PRINT DR$: PRINT "Your files are:": FILES DR$+"*.*": RESUME 40
  85. 530  BEEP: IF ERR<>53 THEN 600
  86. 535  PRINT: PRINT: PRINT TAB(13); "I cannot find a file by that name on drive ";
  87. 540  IF MID$(FILE2$,2,1)=":" THEN DR$=LEFT$(FILE2$,2) ELSE DR$="A:"
  88. 545  PRINT DR$: PRINT "Your files are:": FILES DR$+"*.*": RESUME 80
  89. 550  BEEP: PRINT: IF ERL<>420 THEN 600
  90. 560  IF ERR=61 OR ERR=67 THEN PRINT "That disk is full.  Change disks and try again."
  91. 570  IF ERR=64 OR ERR=52 THEN PRINT "That is not a valid FILE NAME.  Please change name."
  92. 580  IF ERR=70 THEN PRINT "That disk is write-protected.  Put your data on a different disk."
  93. 590  IF ERR=71 THEN PRINT "That disk is not ready.  Check drive and try again."
  94. 595  RESUME 340
  95. 600  ON ERROR GOTO 0
  96.